home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt40s2.arc / OPENFORA.MOD < prev    next >
Text File  |  1987-03-31  |  3KB  |  68 lines
  1. (*----------------------------------------------------------------------*)
  2. (*         Open_For_Append --- Open text file for appending to end      *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. FUNCTION Open_For_Append( VAR F      : Text_File;
  6.                               F_Name : AnyStr   ;
  7.                           VAR Error  : INTEGER   ) : BOOLEAN;
  8.  
  9. (*----------------------------------------------------------------------*)
  10. (*                                                                      *)
  11. (*     Function:   Open_For_Append                                      *)
  12. (*                                                                      *)
  13. (*     Purpose:    Opens text file for append                           *)
  14. (*                                                                      *)
  15. (*     Calling Sequence:                                                *)
  16. (*                                                                      *)
  17. (*        Open_OK := Open_For_Append( VAR F      : Text_File;           *)
  18. (*                                        F_Name : AnyStr   ;           *)
  19. (*                                    VAR Error  : INTEGER ) : BOOLEAN; *)
  20. (*                                                                      *)
  21. (*           F      --- Text file to be opened                          *)
  22. (*           F_Name --- File name of text file                          *)
  23. (*           Error  --- I/O error encountered here                      *)
  24. (*                                                                      *)
  25. (*     Remarks:                                                         *)
  26. (*                                                                      *)
  27. (*        This routine exists to circumvent a bug in Turbo Pascal in    *)
  28. (*        which an attempt to append text to an existing but empty      *)
  29. (*        file causes death.                                            *)
  30. (*                                                                      *)
  31. (*----------------------------------------------------------------------*)
  32.  
  33. VAR
  34.    Open_Ok : BOOLEAN;
  35.    F_Byte  : FILE OF BYTE;
  36.  
  37. BEGIN (* Open_For_Append *)
  38.  
  39.       (*$I-*)
  40.                                    (* See if file exists or is empty.  *)
  41.                                    (* File of byte req'd for filesize. *)
  42.    ASSIGN( F_Byte , F_Name );
  43.    RESET( F_Byte );
  44.  
  45.    Error   := Int24Result;
  46.    Open_OK := ( Error = 0 );
  47.                                    (* If file exists, but is empty, *)
  48.                                    (* use REWRITE to avoid error.   *)
  49.    IF Open_OK THEN
  50.       IF ( LongFileSize( F_Byte ) = 0.0 ) THEN
  51.          Open_OK := FALSE;
  52.  
  53.    CLOSE( F_Byte );
  54.                                    (* Now open file as text file. *)
  55.    ASSIGN( F , F_Name );
  56.  
  57.    IF Open_OK THEN
  58.       APPEND( F )
  59.    ELSE
  60.       REWRITE( F );
  61.  
  62.    Error           := Int24Result;
  63.    Open_For_Append := ( Error = 0 );
  64.  
  65.       (*$I+*)
  66.  
  67. END   (* Open_For_Append *);
  68.